home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / HATSCHI.M < prev    next >
Encoding:
Text File  |  1991-04-09  |  4.0 KB  |  164 lines
  1. MODULE HaTschi;
  2.  
  3. (*
  4.  * Dies ist eine erweiterte Version des bekannten Coroutine-Demoprogramms
  5.  * aus dem Standardwerk "Programmierung in Modula-2" von Dal Cin/Lutz/Risse.
  6.  *
  7.  * Das Hauptmodul erzeugt zwei Coroutinen, die sich dann abwechseld aktivieren.
  8.  * Zusätzlich wird gezeigt, wie IOTRANSFER angewendet werden kann:
  9.  * 1. wird dazu unten eine TRAP-Instruktion statt einer TRANSFER-Anweisung
  10.  *    ausgeführt,
  11.  * 2. wird im lokalen Modul "IR" eine Coroutine als Interruptroutine
  12.  *    installiert.
  13.  *)
  14.  
  15. FROM SYSTEM IMPORT ASSEMBLER;
  16. FROM SYSTEM IMPORT ADDRESS, LISTEN, TRANSFER, IOTRANSFER, NEWPROCESS, ADR;
  17.  
  18. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  19.  
  20. FROM InOut IMPORT KeyPressed, WriteString, WriteLn;
  21.  
  22. FROM RandomGen IMPORT RandomCard;
  23.  
  24. IMPORT MOSGlobals, PrgCtrl; (* nur f. lokales Modul *)
  25.  
  26.  
  27. (*$J-  (für langsame FOR-Schleifen) *)
  28.  
  29.  
  30. MODULE IR [5];
  31.  
  32.   (*
  33.    * Lokales Modul, das sich in VBL-Vektor installiert.
  34.    * Dadurch wird die Routine 'serveProc' regelmäßig vom GEMDOS
  35.    * aufgerufen und setzt nach jeweils einer bestimmten Anzahl
  36.    * von Aufrufen eine Variable ('Key') auf TRUE.
  37.    *)
  38.  
  39.   IMPORT TRANSFER, IOTRANSFER, NEWPROCESS, ADDRESS, ADR, LISTEN;
  40.  
  41.   FROM PrgCtrl IMPORT CatchProcessTerm, TermCarrier;
  42.  
  43.   FROM MOSGlobals IMPORT MemArea;
  44.  
  45.   EXPORT Key;
  46.  
  47.   VAR main, server: ADDRESS;
  48.       stack: ARRAY [1..800] OF CARDINAL;
  49.       terminate, Key: BOOLEAN;
  50.  
  51.   PROCEDURE serveProc;
  52.     VAR i: CARDINAL;
  53.     BEGIN
  54.       i:= 0;
  55.       LOOP
  56.         IOTRANSFER (server, main, $4DEL);  (* VBL-Queue *)
  57.         IF terminate THEN
  58.           TRANSFER (server, main);
  59.         END;
  60.         INC (i);
  61.         IF i > 50 THEN
  62.           Key:= TRUE;
  63.           i:= 0
  64.         END
  65.       END
  66.     END serveProc;
  67.   
  68.   PROCEDURE terminateIR;
  69.     BEGIN
  70.       terminate:= TRUE;
  71.       TRANSFER (main, server)
  72.     END terminateIR;
  73.  
  74.   VAR carrier: TermCarrier;
  75.       wsp: MemArea;
  76.  
  77.   BEGIN
  78.     Key:= FALSE;
  79.     terminate:= FALSE;
  80.  
  81.     (*
  82.      * Prozeß einrichten und starten
  83.      *)
  84.     NEWPROCESS (serveProc, ADR (stack), SIZE (stack), server);
  85.     TRANSFER (main, server);
  86.  
  87.     (*
  88.      * Die Prozedur 'terminateIR' soll dafür sorgen, daß bei
  89.      * Programmende der IOTRANSFER-Zyklus beendet wird.
  90.      *)
  91.     wsp.bottom:= NIL;
  92.     CatchProcessTerm (carrier, terminateIR, wsp);
  93.   END IR;
  94.  
  95.  
  96. CONST StackSize = 2000L;
  97.  
  98. VAR a1, a2: ADDRESS;
  99.     Main, Ha, Tschi: ADDRESS;
  100.     Count: CARDINAL;
  101.     
  102. PROCEDURE schreibeHa;
  103.   VAR l:LONGCARD;
  104.   BEGIN
  105.     LOOP
  106.       IF RandomCard (1,5) # 5 THEN
  107.         WriteString (" Ha ");
  108.         FOR l:= 1L TO 3000L DO END
  109.       ELSE
  110.         IF Key THEN
  111.           Key:= FALSE;
  112.           WriteString (" <Key> ")
  113.         END;
  114.         TRANSFER (Ha, Tschi); (* direkter Transfer auf 'Tschi' *)
  115.         ASSEMBLER
  116.           TRAP #0             (* indirekter Transfer über TRAP #0 -> 'Tschi' *)
  117.         END;
  118.         WriteLn;
  119.       END;
  120.       IF Count >= 50 THEN
  121.         TRANSFER (Ha, Main);  (* Ende *)
  122.       END
  123.     END
  124.   END schreibeHa;
  125.  
  126. PROCEDURE schreibeTschi;
  127.   (*
  128.    * Durch das folgende Verlassen dieser Coroutine über 'IOTRANSFER'
  129.    * statt 'TRANSFER' kann sie sowohl durch einen TRANSFER auf sie
  130.    * zurück als auch über IO-Kanal (in diesem Fall 'TRAP #0') wieder
  131.    * aktiviert werden.
  132.    *)
  133.   BEGIN
  134.     LOOP
  135.       WriteString (" Tschi ");
  136.       INC (Count);
  137.       IOTRANSFER (Tschi, Ha, $80L);  (* Installation auf TRAP #0 *)
  138.     END;
  139.   END schreibeTschi;
  140.  
  141. BEGIN
  142.   ALLOCATE (a1, StackSize);
  143.   ALLOCATE (a2, StackSize);
  144.   NEWPROCESS (schreibeHa, a1, StackSize, Ha);
  145.   NEWPROCESS (schreibeTschi, a2, StackSize, Tschi);
  146.   Count:= 0;
  147.   (*
  148.    * Nun niesen wir ein paarmal...
  149.    *)
  150.   TRANSFER (Main, Ha);
  151.   (*
  152.    * Danach warten wir auf einen Tastendruck, währenddessen weiterhin
  153.    * im VBL-Interrupt 'Key' zyklisch gesetzt wird.
  154.    *)
  155.   WHILE NOT KeyPressed () DO
  156.     IF Key THEN
  157.       Key:= FALSE;
  158.       WriteString (" <Key> ")
  159.     END
  160.   END;
  161.   DEALLOCATE (a1, StackSize);
  162.   DEALLOCATE (a2, StackSize);
  163. END HaTschi.
  164.